home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / source9 / scratch / mscomm / main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  5.3 KB  |  188 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses Messages, WinTypes, WinProcs, Classes, Graphics, Forms, Controls,
  6.      StdCtrls, MSComm, ExtCtrls, Menus, SysUtils, Dialogs, config, about;
  7. type
  8.   TfrmMain = class(TForm)
  9.     memIn: TMemo;
  10.     MainMenu1: TMainMenu;
  11.     File1: TMenuItem;
  12.     Help1: TMenuItem;
  13.     Configure1: TMenuItem;
  14.     About1: TMenuItem;
  15.     Exit1: TMenuItem;
  16.     memOut: TMemo;
  17.     Port1: TMenuItem;
  18.     Open1: TMenuItem;
  19.     Close1: TMenuItem;
  20.     N1: TMenuItem;
  21.     MSComm1: TMSComm;
  22.     procedure MSComm1Receive(Sender: TObject; Count: Word);
  23.     procedure Configure1Click(Sender: TObject);
  24.     procedure memOutKeyPress(Sender: TObject; var Key: Char);
  25.     procedure FormResize(Sender: TObject);
  26.     procedure About1Click(Sender: TObject);
  27.     procedure OpenPort;
  28.     procedure ClosePort;
  29.     procedure Open1Click(Sender: TObject);
  30.     procedure Close1Click(Sender: TObject);
  31.     procedure Exit1Click(Sender: TObject);
  32.   private
  33.   end;
  34.  
  35. var
  36.   frmMain: TfrmMain;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. { fired when we get data from the serial port. Takes the data and
  43.  sends it to the memo component as a keypress windows message.
  44.  I'm not sure this is the most efficient way to do this (?) }
  45. procedure TfrmMain.MSComm1Receive(Sender: TObject; Count: Word);
  46. var
  47.   aChar: Char;
  48.   i: Word;
  49. begin
  50.   for i := 1 to Count do
  51.   begin
  52.     MSComm1.Read(@aChar, SizeOf(aChar));
  53.     SendMessage(memIn.Handle, WM_CHAR, Word(aChar),0);
  54.   end;
  55. end;
  56.  
  57.  
  58. { lets user fritz around with the serial component settings }
  59. procedure TfrmMain.Configure1Click(Sender: TObject);
  60. begin
  61.   { shouldn't be able to change port # if port is open }
  62.   frmSettings.cboPort.Enabled := Open1.Enabled;
  63.   { read settings from comm control into settings dialog }
  64.   frmSettings.cboPort.ItemIndex := MSComm1.Port;
  65.   frmSettings.cboBaud.ItemIndex := Ord(MSComm1.BaudRate);
  66.   frmSettings.cboData.ItemIndex := Ord(MSComm1.DataBits);
  67.   frmSettings.cboParity.ItemIndex := Ord(MSComm1.ParityBits);
  68.   frmSettings.cboStop.ItemIndex := Ord(MSComm1.StopBits);
  69.   frmSettings.cboFlow.ItemIndex := Ord(MSComm1.FlowControl);
  70.   { show settings dialog }
  71.   frmSettings.ShowModal;
  72.   { copy settings from dialog into comm control }
  73.   MSComm1.Port := frmSettings.cboPort.ItemIndex;
  74.   case frmSettings.cboBaud.ItemIndex of
  75.     0: MSComm1.BaudRate := br110;
  76.     1: MSComm1.BaudRate := br300;
  77.     2: MSComm1.BaudRate := br600;
  78.     3: MSComm1.BaudRate := br1200;
  79.     4: MSComm1.BaudRate := br2400;
  80.     5: MSComm1.BaudRate := br4800;
  81.     6: MSComm1.BaudRate := br9600;
  82.     7: MSComm1.BaudRate := br14400;
  83.     8: MSComm1.BaudRate := br19200;
  84.     9: MSComm1.BaudRate := br38400;
  85.     10: MSComm1.BaudRate := br56000;
  86.     11: MSComm1.BaudRate := br128000;
  87.     12: MSComm1.BaudRate := br256000;
  88.   end;
  89.   case frmSettings.cboParity.ItemIndex of
  90.     0: MSComm1.ParityBits := pbNone;
  91.     1: MSComm1.ParityBits := pbOdd;
  92.     2: MSComm1.ParityBits := pbEven;
  93.     3: MSComm1.ParityBits := pbMark;
  94.     4: MSComm1.ParityBits := pbSpace;
  95.   end;
  96.   case frmSettings.cboData.ItemIndex of
  97.     0: MSComm1.DataBits := dbFour;
  98.     1: MSComm1.DataBits := dbFive;
  99.     2: MSComm1.DataBits := dbSix;
  100.     3: MSComm1.DataBits := dbSeven;
  101.     4: MSComm1.DataBits := dbEight;
  102.   end;
  103.   case frmSettings.cboStop.ItemIndex of
  104.     0: MSComm1.StopBits := sbOne;
  105.     1: MSComm1.StopBits := sbOnePointFive;
  106.     2: MSComm1.StopBits := sbTwo;
  107.   end;
  108.   case frmSettings.cboFlow.ItemIndex of
  109.     0: MSComm1.FlowControl := fcNone;
  110.     1: MSComm1.FlowControl := fcRTSCTS;
  111.     2: MSComm1.FlowControl := fcXONXOFF;
  112.   end;
  113. end;
  114.  
  115. { every key press in the bottom window gets sent to the serial component }
  116. procedure TfrmMain.memOutKeyPress(Sender: TObject; var Key: Char);
  117. begin
  118.   MSComm1.Write(@Key,SizeOf(Key))
  119. end;
  120.  
  121. { make the form resize intelligently }
  122. procedure TfrmMain.FormResize(Sender: TObject);
  123. const
  124.   offset = 4;
  125. var
  126.   tempht: Integer;
  127.   tempwd: Integer;
  128. begin
  129.   tempht := Self.Height div 2 - 25;
  130.   tempwd := Self.Width - 7;
  131.   MemIn.SetBounds(offset, offset, tempWd - (offset * 2), tempHt - (offset * 2));
  132.   MemOut.SetBounds(offset, tempht, tempWd - (offset * 2), tempHt - (offset * 2));
  133. end;
  134.  
  135. { show about dialog with control version number in x.xx format }
  136. procedure TfrmMain.About1Click(Sender: TObject);
  137. begin
  138.   frmAbout.lblVersion.Caption := FloatToStrF(MSComm1.Version, ffFixed, 0, 2);
  139.   frmAbout.ShowModal;
  140. end;
  141.  
  142. { attempt to open the port and sets window options appropriately }
  143. procedure TfrmMain.OpenPort;
  144. var
  145.   temp: array [0..254] of char;
  146. begin
  147.   if (not MSComm1.Open) then begin
  148.     Application.MessageBox(StrPCopy(temp, MSComm1.GetError), 'Cannot open comm port', mb_iconstop);
  149.     ClosePort;
  150.     end
  151.   else begin
  152.     memOut.Color := clWindow;
  153.     memOut.Enabled := True;
  154.     memOut.SetFocus;
  155.     Open1.Enabled := False;
  156.     Close1.Enabled := True;
  157.     exit;
  158.   end;
  159. end;
  160.  
  161. { close the port and set window options appropriately }
  162. procedure TfrmMain.ClosePort;
  163. begin
  164.   MSComm1.Close;
  165.   memOut.Clear;
  166.   memOut.Color := clBtnFace;
  167.   memOut.Enabled := False;
  168.   Open1.Enabled := True;
  169.   Close1.Enabled := False;
  170. end;
  171.  
  172. procedure TfrmMain.Open1Click(Sender: TObject);
  173. begin
  174.   OpenPort;
  175. end;
  176.  
  177. procedure TfrmMain.Close1Click(Sender: TObject);
  178. begin
  179.   ClosePort;
  180. end;
  181.  
  182. procedure TfrmMain.Exit1Click(Sender: TObject);
  183. begin
  184.   Close;
  185. end;
  186.  
  187. end.
  188.